home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / games.arc / BIORYTHM.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  4.3 KB  |  194 lines
  1. 10  ' ***********************
  2. 20  ' **     BIORHYTHM     **
  3. 30  ' ***********************
  4. 40  '
  5. 50  CLEAR
  6. 60  SCREEN 0,0,0,0
  7. 70  COLOR 7,0,0
  8. 80  CLS
  9. 90  KEY OFF
  10. 100  OPTION BASE 1
  11. 110  PI = 3.14159
  12. 120  DEF FNDOWN(AMT) = INT(13.5-9*SIN(2*PI*(JULIAN-JULIANB)/AMT))
  13. 130  DEF FNACROSS = 9+DAY+DAY
  14. 140  DEF FNSCR$ = CHR$(SCREEN(CSRLIN,POS(0)))
  15. 150  DIM MONTH.NAME$(12)
  16. 160  FOR I = 1 TO 12
  17. 170  READ MONTH.NAME$(I)
  18. 180  NEXT I
  19. 190  DATA JANUARY,FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY
  20. 200  DATA AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER
  21. 210  '
  22. 220  CLS
  23. 230  LOCATE 7,7
  24. 240  LINE INPUT "Enter birth date ... (any reasonable format) ";CAL$
  25. 250  IF CAL$ = "" THEN 280
  26. 260  GOSUB 1510
  27. 270  IF YEAR THEN 320
  28. 280  LOCATE 9,1
  29. 290  PRINT "The date is unrecognizable, or isn't a valid date ... try again.
  30. 300  BEEP
  31. 310  GOTO 230
  32. 320  MONTHB = MONTH
  33. 330  DAYB = DAY
  34. 340  YEARB = YEAR
  35. 350  JULIANB = JULIAN
  36. 360  LOCATE 9,1
  37. 370  PRINT SPACE$(79);
  38. 380  LOCATE 9,7
  39. 390  LINE INPUT "Enter today's date ... ";CAL$
  40. 400  IF CAL$ = "" THEN 430
  41. 410  GOSUB 1510
  42. 420  IF YEAR THEN 470
  43. 430  LOCATE 11,1
  44. 440  PRINT "Your date is unrecognizable, or isn't a valid date ... try again.
  45. 450  BEEP
  46. 460  GOTO 380
  47. 470  DAY = 1
  48. 480  GOSUB 1210
  49. 490  JULIAN1 = JULIAN
  50. 500  MONTH = MONTH MOD 12 + 1
  51. 510  IF MONTH = 1 THEN YEAR = YEAR + 1
  52. 520  GOSUB 1210
  53. 530  JULIAN2 = JULIAN - 1
  54. 540  JULIAN = JULIAN1
  55. 550  GOSUB 1330
  56. 560  '
  57. 570  WIDTH 80
  58. 580  COLOR 7,0,1
  59. 590  CLS
  60. 600  LABEL$ = "BIORYTHMS - "+MONTH.NAME$(MONTH)+STR$(YEAR)
  61. 610  LABEL$ = LABEL$ + " -  for a birth date of "
  62. 620  LABEL$ = LABEL$ + MONTH.NAME$(MONTHB) + STR$(DAYB)
  63. 630  LABEL$ = LABEL$ + "," + STR$(YEARB)
  64. 640  LOCATE 1,40 - LEN(LABEL$)/2
  65. 650  PRINT LABEL$;
  66. 660  LOCATE 25,1
  67. 670  COLOR 14,0
  68. 680  PRINT "Date -";
  69. 690  LOCATE 3,7
  70. 700  COLOR 10,0
  71. 710  PRINT "p = physical cycle";
  72. 720  LOCATE 3,30
  73. 730  COLOR 11,0
  74. 740  PRINT "s = sensitivity cycle";
  75. 750  LOCATE 3,56
  76. 760  COLOR 13,0
  77. 770  PRINT "c = cognitive cycle";
  78. 780  DAY = 0
  79. 790  COLOR 9,0
  80. 800  LOCATE 13,6
  81. 810  PRINT STRING$(70,"-");
  82. 820  FOR JULIAN = JULIAN1 TO JULIAN2
  83. 830  COLOR 14,0
  84. 840  DAY = DAY + 1
  85. 850  LOCATE 24,9 + DAY + DAY
  86. 860  IF DAY > 9 THEN PRINT CHR$(48+INT(DAY/10));
  87. 870  LOCATE 25,9 + DAY + DAY
  88. 880  PRINT CHR$(48+DAY MOD 10);
  89. 890  COLOR 10,0
  90. 900  LOCATE FNDOWN(23) , FNACROSS
  91. 910  IF FNSCR$ = " " THEN PRINT "p"; ELSE COLOR 12,0 : PRINT "*";
  92. 920  IF FNDOWN(23) <> 14 THEN 960
  93. 930  LOCATE 13,FNACROSS - 1
  94. 940  COLOR 12,0
  95. 950  PRINT "*";
  96. 960  COLOR 11,0
  97. 970  LOCATE FNDOWN(28) , FNACROSS
  98. 980  IF FNSCR$ = " " THEN PRINT "s"; ELSE COLOR 12,0 : PRINT "*";
  99. 990  COLOR 13,0
  100. 1000  LOCATE FNDOWN(33) , FNACROSS
  101. 1010  IF FNSCR$ = " " THEN PRINT "c"; ELSE COLOR 12,0 : PRINT "*";
  102. 1020  IF FNDOWN(33) <> 14 THEN 1060
  103. 1030  LOCATE 13,FNACROSS - 1
  104. 1040  COLOR 12,0
  105. 1050  PRINT "*";
  106. 1060  NEXT JULIAN
  107. 1070  LOCATE 9,1
  108. 1080  K$ = INKEY$
  109. 1090  IF K$ = "" THEN 1080
  110. 1100  END
  111. 1110  '
  112. 1120  ' Subroutine, capitalize cal$
  113. 1130  FOR CP = 1 TO LEN(CAL$)
  114. 1140  CHAR$ = MID$(CAL$,CP,1)
  115. 1150  IF CHAR$ < "a" OR CHAR$ > "z" THEN 1170
  116. 1160  MID$(CAL$,CP,1) = CHR$(ASC(CHAR$)-32)
  117. 1170  NEXT CP
  118. 1180  RETURN
  119. 1190  '
  120. 1200  ' Subroutine, MONTH,DAY,YEAR to JULIAN,WEEKDAY
  121. 1210  JULIAN = INT(365.242 * YEAR + 30.44 * (MONTH-1) + DAY + 1)
  122. 1220  T1 = MONTH - 2 - 12 * (MONTH < 3)
  123. 1230  T2 = YEAR + (MONTH < 3)
  124. 1240  T3 = INT(T2 / 100)
  125. 1250  T2 = T2 - 100 * T3
  126. 1260  WEEKDAY = INT(2.61 * T1 - 0.2) + DAY + T2 + INT(T2 / 4)
  127. 1270  WEEKDAY = (WEEKDAY + INT(T3 / 4) - T3 - T3 + 77) MOD 7 + 1
  128. 1280  T4 = JULIAN - 7 * INT(JULIAN / 7)
  129. 1290  JULIAN = JULIAN - T4 + WEEKDAY + 7 * (T4 < WEEKDAY - 1) + 1.72106E+06
  130. 1300  RETURN
  131. 1310  '
  132. 1320  ' Subroutine, JULIAN to MONTH,DAY,YEAR,WEEKDAY
  133. 1330  T5 = JULIAN
  134. 1340  YEAR = INT((JULIAN - 1.72106E+06) / 365.25 + 1)
  135. 1350  MONTH = 1
  136. 1360  DAY = 1
  137. 1370  GOSUB 1210
  138. 1380  IF JULIAN <= T5 THEN 1410
  139. 1390  YEAR = YEAR - 1
  140. 1400  GOTO 1370
  141. 1410  MONTH = INT((T5 - JULIAN) / 29 + 1)
  142. 1420  GOSUB 1210
  143. 1430  IF JULIAN <= T5 THEN 1460
  144. 1440  MONTH = MONTH - 1
  145. 1450  GOTO 1420
  146. 1460  DAY = T5 - JULIAN + 1
  147. 1470  GOSUB 1210
  148. 1480  RETURN
  149. 1490  '
  150. 1500  ' Subroutine, convert CAL$ to MONTH,DAY,YEAR
  151. 1510  GOSUB 1130
  152. 1520  MONTH = 0
  153. 1530  DAY = 0
  154. 1540  YEAR = 0
  155. 1550  FOR I = 1 TO 12
  156. 1560  IF INSTR(CAL$,LEFT$(MONTH.NAME$(I),3)) THEN MONTH = I
  157. 1570  NEXT I
  158. 1580  FOR I = 1 TO LEN(CAL$)
  159. 1590  CHAR$ = MID$(CAL$,I,1)
  160. 1600  IF CHAR$ < "0" OR CHAR$ > "9" THEN MID$(CAL$,I,1) = ":"
  161. 1610  NEXT I
  162. 1620  IF INSTR(CAL$,":") THEN 1680
  163. 1630  IF LEN(CAL$) <> 6 AND LEN(CAL$) <> 8 THEN 1930
  164. 1640  MONTH = VAL(LEFT$(CAL$,2))
  165. 1650  DAY = VAL(MID$(CAL$,3,2))
  166. 1660  YEAR = VAL(MID$(CAL$,5))
  167. 1670  GOTO 1820
  168. 1680  VFLAG = 0
  169. 1690  FOR I = 1 TO LEN(CAL$)
  170. 1700  CALVAL = VAL(MID$(CAL$,I))
  171. 1710  IF CALVAL = 0 THEN VFLAG = 0
  172. 1720  IF CALVAL = 0 OR VFLAG = 1 THEN 1810
  173. 1730  IF MONTH THEN 1760
  174. 1740  MONTH = CALVAL
  175. 1750  GOTO 1800
  176. 1760  IF DAY THEN 1790
  177. 1770  DAY = CALVAL
  178. 1780  GOTO 1800
  179. 1790  YEAR = CALVAL
  180. 1800  VFLAG = 1
  181. 1810  NEXT I
  182. 1820  IF YEAR < 100 AND YEAR > 0 THEN YEAR = YEAR + 1900
  183. 1830  IF YEAR < 1582 OR YEAR > 3999 THEN YEAR = 0
  184. 1840  IF YEAR = 0 THEN 1930
  185. 1850  MONTH2 = MONTH
  186. 1860  DAY2 = DAY
  187. 1870  YEAR2 = YEAR
  188. 1880  GOSUB 1210
  189. 1890  GOSUB 1330
  190. 1900  IF MONTH2 <> MONTH THEN YEAR = 0
  191. 1910  IF DAY2 <> DAY THEN YEAR = 0
  192. 1920  IF YEAR2 <> YEAR THEN YEAR = 0
  193. 1930  RETURN
  194.